home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 60.zip / BS1 part 60 / Highspeed pascal.adf / HSPascal / AmigaDemos / Speech.pas < prev    next >
Pascal/Delphi Source File  |  1992-01-16  |  5KB  |  188 lines
  1. {--------------------------------------------------------------------------
  2.  
  3.                      HighSpeed Pascal for the Amiga
  4.  
  5.                          SPEECH SYNTH INTERFACE
  6.  
  7.                   Programmed by Martin Eskildsen 1991
  8.  
  9.                   Copyright (c) 1991 by D-House I ApS
  10.                          All rights reserved
  11.  
  12.  
  13.   Version : Date (dd.mm.yy) : Comment
  14.   -----------------------------------
  15.     1.00 : 06.11.91 : First version
  16.     1.01 : 16.12.91 : Updated for final Amiga unit
  17. --------------------------------------------------------------------------}
  18.  
  19. unit Speech;
  20.  
  21. INTERFACE
  22.  
  23. uses Narrator, Translator, Exec, Amiga;
  24.  
  25. type
  26.   Parameters    = (PitchParam, VolumeParam, SexParam, RateParam, ModeParam,
  27.                    FreqParam);
  28.   ParamSet      = set of Parameters;
  29.   Sex           = (male, female);
  30.   Mode          = (human, robot);
  31.   PitchRange    = MINPITCH..MAXPITCH;
  32.   VolumeRange   = MINVOL..MAXVOL;
  33.   FreqRange     = MINFREQ..MAXFREQ;
  34.   RateRange     = MINRATE..MAXRATE;
  35.  
  36. function  OpenSpeech : boolean;         { TRUE = success }
  37. procedure CloseSpeech;
  38.  
  39. procedure Say(s : string);
  40.  
  41. procedure SetFrequency(n : FreqRange);
  42. procedure SetRate     (n : RateRange);
  43. procedure SetPitch    (n : PitchRange);
  44. procedure SetMode     (n : Mode);
  45. procedure SetSex      (n : Sex);
  46. procedure SetVolume   (n : VolumeRange);
  47.  
  48. procedure DefaultParameters(p : ParamSet);
  49.  
  50. IMPLEMENTATION
  51.  
  52. const
  53.   AudioChannelMasks : array [1..4] of byte = (3, 5, 10, 12);
  54.  
  55. type
  56.   pNarrator_rb  = ^tNarrator_rb;
  57.  
  58. var
  59.   writeNarrator : pNarrator_rb;
  60.   writePort     : pMsgPort;
  61.   output_buf    : packed array [0..2047] of char;
  62.   SpeechLive    : boolean;              { TRUE = speech is opened }
  63.  
  64. function OpenSpeech : boolean;
  65. label 1;                { Oh yes, labels are "allowed" when sensible! }
  66. const Revision = 0;
  67.  
  68.   procedure CloseDown;
  69.   begin
  70.     if TranslatorBase       <> NIL then CloseLibrary(pLibrary(TranslatorBase));
  71.     if writePort^.mp_sigbit <> -1  then DeletePort(writePort);
  72.     if writeNarrator        <> NIL then begin
  73.       CloseDevice(pIORequest(writeNarrator));
  74.       DeleteExtIO(pIORequest(writeNarrator))
  75.     end
  76.   end;
  77.  
  78. begin
  79.   if SpeechLive then goto 1;                     { Get out of here if open }
  80.   SpeechLive := FALSE;        { Default state in case something goes wrong }
  81.   FillChar(output_buf, sizeof(output_buf), #0);             { Empty buffer }
  82.  
  83.   TranslatorBase := pLibrary(OpenLibrary('translator.library', Revision));
  84.   if TranslatorBase = NIL then begin    { Abort if error }
  85.     CloseDown;
  86.     goto 1
  87.   end;
  88.  
  89.   writePort     := CreatePort(NIL,0);
  90.   writeNarrator := pNarrator_rb(CreateExtIO(writePort, sizeof(tNarrator_rb)));
  91.  
  92.   with writeNarrator^ do begin
  93.     ch_masks := @AudioChannelMasks;             { Audio channes to use }
  94.     nm_masks := sizeof(AudioChannelMasks);      { Number of channels }
  95.     mouths   := 0;                              { No mouth }
  96.     with message do begin
  97.       IO_data    := @output_buf;                { Where to get data from }
  98.       IO_command := CMD_WRITE;                  { This is a Write block }
  99.       IO_offset  := 0;
  100.       IO_length  := 1                           { Only one char right now }
  101.     end                                         { ( = #0 ) }
  102.   end;
  103.  
  104.   if OpenDevice('narrator.device', 0, pIORequest(writeNarrator), 0) <> 0 then begin
  105.     CloseDown;
  106.     goto 1
  107.   end;
  108.  
  109.   DefaultParameters([SexParam, RateParam, VolumeParam, PitchParam,
  110.                      FreqParam, ModeParam]);
  111.  
  112.   SpeechLive := TRUE;           { Success! }
  113.   1:                            { Where to go if problems }
  114.   OpenSpeech := SpeechLive
  115. end;
  116.  
  117. procedure CloseSpeech;
  118. begin
  119.   if SpeechLive then begin
  120.     CloseLibrary(pLibrary(TranslatorBase));
  121.     DeletePort(writePort);
  122.     CloseDevice(pIORequest(writeNarrator));
  123.     DeleteExtIO(pIORequest(writeNarrator));
  124.     SpeechLive := FALSE
  125.   end
  126. end;
  127.  
  128. procedure Say(s : string);
  129. var
  130.   return : longint;
  131.   i      : integer;
  132. begin
  133.   s := s + #0;
  134.   return := Translate(@s[1], length(s), @output_buf, sizeof(output_buf) - 1);
  135.   i := 0;  while output_buf[i] <> #0 do inc(i);         { C str. length }
  136.   writeNarrator^.message.IO_length := i;
  137.   return := DoIO(pIORequest(writeNarrator))
  138. end;
  139.  
  140. procedure SetFrequency(n : FreqRange);
  141. begin
  142.   writeNarrator^.sampfreq := n
  143. end;
  144.  
  145. procedure SetRate(n : RateRange);
  146. begin
  147.   writeNarrator^.rate := n
  148. end;
  149.  
  150. procedure SetPitch(n : PitchRange);
  151. begin
  152.   writeNarrator^.pitch := n
  153. end;
  154.  
  155. procedure SetMode(n : Mode);
  156. begin
  157.   writeNarrator^.mode := ord(n)       { Trick! As n is an enumerated type }
  158. end;                                  { it has values 0 and 1 which are }
  159.                                       { the same values as NATURALF0 (0) }
  160.                                       { and ROBOTICF0 (1), so all we need }
  161.                                       { is to construct our subrange proper-}
  162.                                       { ly (human, robot) }
  163.  
  164. procedure SetSex(n : Sex);
  165. begin
  166.   writeNarrator^.sex := ord(n)        { As above }
  167. end;
  168.  
  169. procedure SetVolume(n : VolumeRange);
  170. begin
  171.   writeNarrator^.volume := n
  172. end;
  173.  
  174. procedure DefaultParameters(p : ParamSet);
  175. begin
  176.   if SexParam    in p then SetSex      (male);
  177.   if VolumeParam in p then SetVolume   (DEFVOL);
  178.   if RateParam   in p then SetRate     (DEFRATE);
  179.   if ModeParam   in p then SetMode     (human);
  180.   if PitchParam  in p then SetPitch    (DEFPITCH);
  181.   if FreqParam   in p then SetFrequency(DEFFREQ)
  182. end;
  183.  
  184. begin
  185.   writeNarrator := NIL;
  186.   SpeechLive := FALSE
  187. end.
  188.